home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1993…stman Always Clicks Twice / ADC Developer CD (1993-01) (''The Postman Always Clicks Twice'')_iso / Dev.CD 199301.iso / Development Platforms / LISP Related / LISP Goodies / matt's utils 8sept / object-FDI-mouse-copy-glue.lisp < prev    next >
Encoding:
Text File  |  1992-08-15  |  2.6 KB  |  85 lines  |  [TEXT/CCL2]
  1. ;;;
  2. ;;; object-FDI-mouse-copy-glue.lisp
  3. ;;;
  4.  
  5. #|
  6. ================================================================
  7. Purpose ========================================================
  8. ================================================================
  9. Defines functions to make the "MOUSE-COPY" example do links.
  10.  
  11.  
  12. ================================================================
  13. Status =========================================================
  14. ================================================================
  15. In-progress.
  16.  
  17.  
  18. ================================================================
  19. Change history =================================================
  20. ================================================================
  21. 15-Aug-92 mc    Created.
  22.  
  23. |#
  24.  
  25.  
  26. (in-package "CCL")
  27.  
  28. (require "MOUSE-COPY")
  29. (require "OBJECT-FRED-DIALOG-ITEM" "CCL:UMASS Utils;object-fred-dialog-item")
  30.  
  31.  
  32. ;;;================================================================
  33. ;;; Define functions to make the "MOUSE-COPY" example do links.
  34. ;;;================================================================
  35.  
  36. #|
  37. Since mouse copy uses text, and since we need objects to call add-link,
  38. we need a convention for doing so. Our solution uses a convention
  39. similar to mouse copy's which sets * to the object, except participating
  40. give-text methods set *l-object-given* to a list of the form
  41. (:gave-object-text object) where object is the object that was clicked
  42. on to generate give-text's string.
  43. |#
  44.  
  45.  
  46. (defparameter *l-object-given* ()
  47.   "A list of the form (:gave-object-text object), set by following general
  48. give-text method.")
  49.  
  50.  
  51. (defmethod give-text :before ((v t))
  52.   "Resets *l-object-given* to nil so we can know whether object text was
  53. given."
  54.   ;;
  55.   (setf *l-object-given* nil))
  56.  
  57.  
  58. ;;; Patch mouse-copy's give-text methods that set * :
  59.  
  60. (defmethod give-text :after ((v sequence-dialog-item))
  61.   (setf *l-object-given* `(:gave-object-text ,*)))
  62.  
  63. (defmethod give-text :after ((view inspector::inspector-view))
  64.   (setf *l-object-given* `(:gave-object-text ,*)))
  65.  
  66. (defmethod give-text :after ((w menu-of-defs-dialog))
  67.   (setf *l-object-given* `(:gave-object-text ,*)))
  68.  
  69.  
  70. (defmethod insert-text ((v object-fred-dialog-item) string)
  71.   "If *l-object-given* is a list of the form described above then add-link
  72. is called on *l-object-given*'s second value. Otherwise does the usual."
  73.   (declare (ignore string)
  74.            (optimize speed))
  75.   ;;
  76.   (cond ((and *l-object-given*
  77.               (not (stringp (second *l-object-given*))))
  78.          (add-link v (second *l-object-given*) (buffer-position (fred-buffer v)))
  79.          (fred-update v))
  80.         (t (call-next-method))))
  81.  
  82.  
  83. ;;; Done.
  84.  
  85. (provide "OBJECT-FDI-MOUSE-COPY-GLUE")